
{***********************************************************}
{                                                           }
{      Informix Data Access Components                      }
{                                                           }
{      TIfxVisualMonitor component                          }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit IfxVisualMonitor;

{$I lx.inc}

interface

uses
  SysUtils, Classes, Forms, IfxMonitor;


type

{ Enumerations }

  TIfxMonitorPosition = (mpDefault, mpTopLeft, mpTopRight, mpBottomLeft,
    mpBottomRight);

    
const

{ Property Default Values }

  IFX_DEFAULT_AUTO_SHOW = True;
  IFX_DEFAULT_CAPACITY = 100;
  IFX_DEFAULT_INVERTED_ORDER = False;
  IFX_DEFAULT_POSITION = mpTopRight;
  IFX_DEFAULT_WIDTH = 512;
  IFX_DEFAULT_HEIGHT = 192;
  IFX_DEFAULT_STAYONTOP = True;
  IFX_DEFAULT_HELP_ON_ERROR = True;
  IFX_DEFAULT_HELP_FILE = 'en_us\04e4\errmess.hlp';


type

{ TIfxVisualMonitor }

  TIfxVisualMonitor = class(TIfxCustomMonitor)
  private
    FAutoShow: Boolean;
    FCapacity: Integer;
    FInvertedOrder: Boolean;
    FPosition: TIfxMonitorPosition;
    FHelpOnError: Boolean;
    FHelpFile: string;
    FForm: TForm;

    procedure SetPosition(Value: TIfxMonitorPosition);
    function GetWidth: Integer;
    procedure SetWidth(Value: Integer);
    function GetHeight: Integer;
    procedure SetHeight(Value: Integer);
    function GetStayOnTop: Boolean;
    procedure SetStayOnTop(Value: Boolean);

    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure MenuPopup(Sender: TObject);
    procedure AutoShowClick(Sender: TObject);
    procedure StayOnTopClick(Sender: TObject);
    procedure HelpOnErrorClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure CloseClick(Sender: TObject);

  protected
    procedure Loaded; override;
    procedure InternalHandleEvent(EventType: TIfxMonitorEventType;
      const Message: string); override;
    procedure InternalHandleException(E: Exception); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Show;
    procedure Close;
    procedure Clear;

  published
    property AutoShow: Boolean read FAutoShow write FAutoShow default IFX_DEFAULT_AUTO_SHOW;
    property Capacity: Integer read FCapacity write FCapacity default IFX_DEFAULT_CAPACITY;
    property InvertedOrder: Boolean read FInvertedOrder write FInvertedOrder default IFX_DEFAULT_INVERTED_ORDER;
    property Position: TIfxMonitorPosition read FPosition write SetPosition default IFX_DEFAULT_POSITION;
    property Width: Integer read GetWidth write SetWidth default IFX_DEFAULT_WIDTH;
    property Height: Integer read GetHeight write SetHeight default IFX_DEFAULT_HEIGHT;
    property StayOnTop: Boolean read GetStayOnTop write SetStayOnTop default IFX_DEFAULT_STAYONTOP;
    property HelpOnError: Boolean read FHelpOnError write FHelpOnError default IFX_DEFAULT_HELP_ON_ERROR;
    property HelpFile: string read FHelpFile write FHelpFile;
  end;


implementation

uses Windows, Controls, StdCtrls, Menus, IfxConsts, Ifx, IfxIntf;


{ TIfxVisualMonitor }

constructor TIfxVisualMonitor.Create(AOwner: TComponent);
var
  Memo: TMemo;
  Menu: TPopupMenu;
  MenuItem: TMenuItem;
begin
  inherited;

  FAutoShow         := IFX_DEFAULT_AUTO_SHOW;
  FCapacity         := IFX_DEFAULT_CAPACITY;
  FInvertedOrder    := IFX_DEFAULT_INVERTED_ORDER;
  FHelpOnError      := IFX_DEFAULT_HELP_ON_ERROR;
  FHelpFile         := IFX_DEFAULT_HELP_FILE;

  FForm             := TForm.Create(nil);
  FForm.BorderStyle := bsSizeToolWin;
  FForm.OnKeyDown   := FormKeyDown;
  FForm.KeyPreview  := True;
  FForm.Caption     := SVisualCaption;
  FForm.Width       := IFX_DEFAULT_WIDTH;
  FForm.Height      := IFX_DEFAULT_HEIGHT;
  StayOnTop         := IFX_DEFAULT_STAYONTOP;
  SetPosition(IFX_DEFAULT_POSITION);

  Memo              := TMemo.Create(FForm);
  Memo.Ctl3D        := False;
  Memo.Align        := alClient;
  Memo.Font.Name    := 'Courier New';
  Memo.WordWrap     := False;
  Memo.ReadOnly     := True;
  Memo.ScrollBars   := ssBoth;

  Menu              := TPopupMenu.Create(FForm);
  Menu.OnPopup      := MenuPopup;

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := SMenuAutoShow;
  MenuItem.OnClick  := AutoShowClick;
  Menu.Items.Add(MenuItem);

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := SMenuStayOnTop;
  MenuItem.OnClick  := StayOnTopClick;
  Menu.Items.Add(MenuItem);

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := SMenuHelpOnError;
  MenuItem.OnClick  := HelpOnErrorClick;
  Menu.Items.Add(MenuItem);

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := '-';
  Menu.Items.Add(MenuItem);

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := SMenuClear;
  MenuItem.OnClick  := ClearClick;
  Menu.Items.Add(MenuItem);

  MenuItem          := TMenuItem.Create(Menu);
  MenuItem.Caption  := SMenuClose;
  MenuItem.OnClick  := CloseClick;
  Menu.Items.Add(MenuItem);

  Memo.PopupMenu    := Menu;

  FForm.InsertControl(Memo);
end;

destructor TIfxVisualMonitor.Destroy;
begin
  FForm.Free;

  inherited;
end;

procedure TIfxVisualMonitor.Show;
begin
  FForm.Show;
end;

procedure TIfxVisualMonitor.Close;
begin
  FForm.Close;
end;

procedure TIfxVisualMonitor.Clear;
begin
  TMemo(FForm.Controls[0]).Clear;
end;

procedure TIfxVisualMonitor.Loaded;
begin
  inherited;
  SetPosition(FPosition);
end;

procedure TIfxVisualMonitor.InternalHandleEvent(EventType: TIfxMonitorEventType;
  const Message: string);
var
  Lines: TStrings;
  Msg: string;
begin
  Lines := TMemo(FForm.Controls[0]).Lines;

  Msg := Format('%-8s %-12s %s', [TimeToStr(Now), EventTypeToString[EventType],
    Message]);

  Lines.BeginUpdate;
  try
    while Lines.Count > FCapacity - 1 do
      if FInvertedOrder then
        Lines.Delete(Lines.Count - 1) else
        Lines.Delete(0);
  finally
    Lines.EndUpdate;
  end;

  if FInvertedOrder then
    Lines.Insert(0, Msg) else
    Lines.Add(Msg);

  if FAutoShow and not FForm.Visible then
    Show;
end;

procedure TIfxVisualMonitor.InternalHandleException(E: Exception);
var
  FileName: string;
begin
  inherited;
  if FHelpOnError and (E is EIfxError) then
  begin
    if not FileExists(FHelpFile) then
      FileName := ifx_getenv('INFORMIXDIR') + '\msg\' + FHelpFile else
      FileName := FHelpFile;
    WinHelp(0, PChar(FileName), HELP_CONTEXT, EIfxError(E).SQL);
  end;
end;

procedure TIfxVisualMonitor.SetPosition(Value: TIfxMonitorPosition);
begin
  if not (csLoading in ComponentState) then
    if Value = mpDefault then
      FForm.Position := poDefaultPosOnly else
    begin
      FForm.Position := poDesigned;
      case Value of
        mpTopLeft:
          begin
            FForm.Left := 0;
            FForm.Top := 0;
          end;
        mpTopRight:
          begin
            FForm.Left := Screen.DesktopWidth - Width;
            FForm.Top := 0;
          end;
        mpBottomLeft:
          begin
            FForm.Left := 0;
            FForm.Top := Screen.DesktopHeight - Height;
          end;
        mpBottomRight:
          begin
            FForm.Left := Screen.DesktopWidth - Width;
            FForm.Top := Screen.DesktopHeight - Height;
          end;
      end;
    end;
  FPosition := Value;
end;

function TIfxVisualMonitor.GetWidth: Integer;
begin
  Result := FForm.Width;
end;

procedure TIfxVisualMonitor.SetWidth(Value: Integer);
begin
  FForm.Width := Value;
end;

function TIfxVisualMonitor.GetHeight: Integer;
begin
  Result := FForm.Height;
end;

procedure TIfxVisualMonitor.SetHeight(Value: Integer);
begin
  FForm.Height := Value;
end;

function TIfxVisualMonitor.GetStayOnTop: Boolean;
begin
  Result := FForm.FormStyle = fsStayOnTop;
end;

procedure TIfxVisualMonitor.SetStayOnTop(Value: Boolean);
begin
  if Value then
    FForm.FormStyle := fsStayOnTop else
    FForm.FormStyle := fsNormal;
end;

procedure TIfxVisualMonitor.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Close;
end;

procedure TIfxVisualMonitor.MenuPopup(Sender: TObject);
begin
  TPopupMenu(Sender).Items[0].Checked := FAutoShow;
  TPopupMenu(Sender).Items[1].Checked := StayOnTop;
  TPopupMenu(Sender).Items[2].Checked := FHelpOnError;
end;

procedure TIfxVisualMonitor.AutoShowClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;

  FAutoShow := TMenuItem(Sender).Checked;
end;

procedure TIfxVisualMonitor.StayOnTopClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;

  SetStayOnTop(TMenuItem(Sender).Checked);
end;

procedure TIfxVisualMonitor.HelpOnErrorClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;

  FHelpOnError := TMenuItem(Sender).Checked;
end;

procedure TIfxVisualMonitor.ClearClick(Sender: TObject);
begin
  Clear;
end;

procedure TIfxVisualMonitor.CloseClick(Sender: TObject);
begin
  Close;
end;


end.